home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / focusTcl.test < prev    next >
Encoding:
Text File  |  1995-05-05  |  6.6 KB  |  263 lines
  1. # This file is a Tcl script to test out the features of the script
  2. # file focus.tcl, which includes the procedures tk_focusNext and
  3. # tk_focusPrev, among other things.  This file is organized in the
  4. # standard fashion for Tcl tests.
  5. #
  6. # Copyright (c) 1995 Sun Microsystems, Inc.
  7. #
  8. # See the file "license.terms" for information on usage and redistribution
  9. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10. #
  11. # @(#) focusTcl.test 1.4 95/05/04 17:34:02
  12.  
  13. if {[info procs test] != "test"} {
  14.     source defs
  15. }
  16.  
  17. eval destroy [winfo children .]
  18. wm geometry . {}
  19. raise .
  20.  
  21. proc setup1 w {
  22.     if {$w == "."} {
  23.     set w ""
  24.     }
  25.     foreach i {a b c d} {
  26.     frame  $w.$i -width 100 -height 50 -bd 2 -relief raised
  27.     pack $w.$i
  28.     }
  29.     .b configure -width 0 -height 0
  30.     foreach i {x y z} {
  31.     button $w.b.$i -text "Button $w.b.$i"
  32.     pack $w.b.$i -side left
  33.     }
  34.     update
  35. }
  36.  
  37. option add *takeFocus 1
  38. option add *highlightThickness 2
  39. . configure -takefocus 1 -highlightthickness 2
  40. test focusTcl-1.1 {tk_focusNext procedure, no children} {
  41.     tk_focusNext .
  42. } {.}
  43. setup1 .
  44. test focusTcl-1.2 {tk_focusNext procedure, basic tree traversal} {
  45.     tk_focusNext .
  46. } {.a}
  47. test focusTcl-1.3 {tk_focusNext procedure, basic tree traversal} {
  48.     tk_focusNext .a
  49. } {.b}
  50. test focusTcl-1.4 {tk_focusNext procedure, basic tree traversal} {
  51.     tk_focusNext .b
  52. } {.b.x}
  53. test focusTcl-1.5 {tk_focusNext procedure, basic tree traversal} {
  54.     tk_focusNext .b.x
  55. } {.b.y}
  56. test focusTcl-1.6 {tk_focusNext procedure, basic tree traversal} {
  57.     tk_focusNext .b.y
  58. } {.b.z}
  59. test focusTcl-1.7 {tk_focusNext procedure, basic tree traversal} {
  60.     tk_focusNext .b.z
  61. } {.c}
  62. test focusTcl-1.8 {tk_focusNext procedure, basic tree traversal} {
  63.     tk_focusNext .c
  64. } {.d}
  65. test focusTcl-1.9 {tk_focusNext procedure, basic tree traversal} {
  66.     tk_focusNext .d
  67. } {.}
  68. foreach w {.b .b.x .b.y .c .d} {
  69.     $w configure -takefocus 0
  70. }
  71. test focusTcl-1.10 {tk_focusNext procedure, basic tree traversal} {
  72.     tk_focusNext .a
  73. } {.b.z}
  74. test focusTcl-1.11 {tk_focusNext procedure, basic tree traversal} {
  75.     tk_focusNext .b.z
  76. } {.}
  77. test focusTcl-1.12 {tk_focusNext procedure, basic tree traversal} {
  78.     eval destroy [winfo child .]
  79.     setup1 .
  80.     update
  81.     . configure -takefocus 0
  82.     tk_focusNext .d
  83. } {.a}
  84. . configure -takefocus 1
  85.  
  86. eval destroy [winfo child .]
  87. setup1 .
  88. toplevel .t
  89. wm geom .t +0+0
  90. toplevel .t2
  91. wm geom .t2 -0+0
  92. raise .t .a
  93. test focusTcl-2.1 {tk_focusNext procedure, toplevels} {
  94.     tk_focusNext .a
  95. } {.b}
  96. test focusTcl-2.2 {tk_focusNext procedure, toplevels} {
  97.     tk_focusNext .d
  98. } {.}
  99. test focusTcl-2.3 {tk_focusNext procedure, toplevels} {
  100.     tk_focusNext .t
  101. } {.t}
  102. setup1 .t
  103. raise .t.b
  104. test focusTcl-2.4 {tk_focusNext procedure, toplevels} {
  105.     tk_focusNext .t
  106. } {.t.a}
  107. test focusTcl-2.5 {tk_focusNext procedure, toplevels} {
  108.     tk_focusNext .t.b.z
  109. } {.t}
  110.  
  111. eval destroy [winfo child .]
  112. test focusTcl-3.1 {tk_focusPrev procedure, no children} {
  113.     tk_focusPrev .
  114. } {.}
  115. setup1 .
  116. test focusTcl-3.2 {tk_focusPrev procedure, basic tree traversal} {
  117.     tk_focusPrev .
  118. } {.d}
  119. test focusTcl-3.3 {tk_focusPrev procedure, basic tree traversal} {
  120.     tk_focusPrev .d
  121. } {.c}
  122. test focusTcl-3.4 {tk_focusPrev procedure, basic tree traversal} {
  123.     tk_focusPrev .c
  124. } {.b.z}
  125. test focusTcl-3.5 {tk_focusPrev procedure, basic tree traversal} {
  126.     tk_focusPrev .b.z
  127. } {.b.y}
  128. test focusTcl-3.6 {tk_focusPrev procedure, basic tree traversal} {
  129.     tk_focusPrev .b.y
  130. } {.b.x}
  131. test focusTcl-3.7 {tk_focusPrev procedure, basic tree traversal} {
  132.     tk_focusPrev .b.x
  133. } {.b}
  134. test focusTcl-3.8 {tk_focusPrev procedure, basic tree traversal} {
  135.     tk_focusPrev .b
  136. } {.a}
  137. test focusTcl-3.9 {tk_focusPrev procedure, basic tree traversal} {
  138.     tk_focusPrev .a
  139. } {.}
  140.  
  141. eval destroy [winfo child .]
  142. setup1 .
  143. toplevel .t
  144. wm geom .t +0+0
  145. toplevel .t2
  146. wm geom .t2 -0+0
  147. raise .t .a
  148. test focusTcl-4.1 {tk_focusPrev procedure, toplevels} {
  149.     tk_focusPrev .
  150. } {.d}
  151. test focusTcl-4.2 {tk_focusPrev procedure, toplevels} {
  152.     tk_focusPrev .b
  153. } {.a}
  154. test focusTcl-4.3 {tk_focusPrev procedure, toplevels} {
  155.     tk_focusPrev .t
  156. } {.t}
  157. setup1 .t
  158. update
  159. .t configure -takefocus 0
  160. raise .t.b
  161. test focusTcl-4.4 {tk_focusPrev procedure, toplevels} {
  162.     tk_focusPrev .t
  163. } {.t.b.z}
  164. test focusTcl-4.5 {tk_focusPrev procedure, toplevels} {
  165.     tk_focusPrev .t.a
  166. } {.t.b.z}
  167.  
  168. eval destroy [winfo child .]
  169. test focusTcl-5.1 {tkFocusOK procedure, -takefocus 0} {
  170.     eval destroy [winfo child .]
  171.     setup1 .
  172.     .b.x configure -takefocus 0
  173.     tk_focusNext .b
  174. } {.b.y}
  175. test focusTcl-5.2 {tkFocusOK procedure, -takefocus 1} {
  176.     eval destroy [winfo child .]
  177.     setup1 .
  178.     pack forget .b
  179.     update
  180.     .b configure -takefocus ""
  181.     .b.y configure -takefocus ""
  182.     .b.z configure -takefocus ""
  183.     list [tk_focusNext .a] [tk_focusNext .b.x]
  184. } {.c .c}
  185. test focusTcl-5.3 {tkFocusOK procedure, -takefocus procedure} {
  186.     proc t w {
  187.     if {$w == ".b.x"} {
  188.         return 1
  189.     } elseif {$w == ".b.y"} {
  190.         return ""
  191.     }
  192.     return 0
  193.     }
  194.     eval destroy [winfo child .]
  195.     setup1 .
  196.     pack forget .b.y
  197.     update
  198.     .b configure -takefocus ""
  199.     foreach w {.b.x .b.y .b.z .c} {
  200.     $w configure -takefocus t
  201.     }
  202.     list [tk_focusNext .a] [tk_focusNext .b.x]
  203. } {.b.x .d}
  204. test focusTcl-5.4 {tkFocusOK procedure, -takefocus ""} {
  205.     eval destroy [winfo child .]
  206.     setup1 .
  207.     .b.x configure -takefocus ""
  208.     update
  209.     tk_focusNext .b
  210. } {.b.x}
  211. test focusTcl-5.5 {tkFocusOK procedure, -takefocus "", not mapped} {
  212.     eval destroy [winfo child .]
  213.     setup1 .
  214.     .b.x configure -takefocus ""
  215.     pack unpack .b.x
  216.     update
  217.     tk_focusNext .b
  218. } {.b.y}
  219. test focusTcl-5.6 {tkFocusOK procedure, -takefocus "", not mapped} {
  220.     eval destroy [winfo child .]
  221.     setup1 .
  222.     foreach w {.b.x .b.y .b.z} {
  223.     $w configure -takefocus ""
  224.     }
  225.     pack unpack .b
  226.     update
  227.     tk_focusNext .b
  228. } {.c}
  229. test focusTcl-5.7 {tkFocusOK procedure, -takefocus "", window disabled} {
  230.     eval destroy [winfo child .]
  231.     setup1 .
  232.     foreach w {.b.x .b.y .b.z} {
  233.     $w configure -takefocus ""
  234.     }
  235.     update
  236.     .b.x configure -state disabled
  237.     tk_focusNext .b
  238. } {.b.y}
  239. test focusTcl-5.8 {tkFocusOK procedure, -takefocus "", check for bindings} {
  240.     eval destroy [winfo child .]
  241.     setup1 .
  242.     foreach w {.a .b .c .d} {
  243.     $w configure -takefocus ""
  244.     }
  245.     update
  246.     bind .a <Key> {foo}
  247.     list [tk_focusNext .] [tk_focusNext .a]
  248. } {.a .b.x}
  249. test focusTcl-5.9 {tkFocusOK procedure, -takefocus "", check for bindings} {
  250.     eval destroy [winfo child .]
  251.     setup1 .
  252.     foreach w {.a .b .c .d} {
  253.     $w configure -takefocus ""
  254.     }
  255.     update
  256.     bind Frame <Key> {foo}
  257.     list [tk_focusNext .] [tk_focusNext .a]
  258. } {.a .b}
  259.  
  260. bind Frame <Key> {}
  261. . configure -takefocus 0 -highlightthickness 0
  262. option clear
  263.